
package provide pdtk_canvas 0.1

package require pd_bindings

namespace eval ::pdtk_canvas:: {
    namespace export pdtk_canvas_popup
}

# TODO figure out weird frameless window when you open a graph

#------------------------------------------------------------------------------#
# canvas new/saveas

proc pdtk_canvas_new {mytoplevel width height geometry editable} {
    # TODO check size of window
    # TODO slide offscreen windows into view
    set ::loaded($mytoplevel) 0
    toplevel $mytoplevel -width $width -height $height -class CanvasWindow
    wm group $mytoplevel .
    $mytoplevel configure -menu $::canvas_menubar

    # TODO slide off screen windows into view
    wm geometry $mytoplevel $geometry
    wm minsize $mytoplevel $::canvas_minwidth $::canvas_minheight

    set mycanvas $mytoplevel.c
    canvas $mycanvas -width $width -height $height \
        -highlightthickness 0 -scrollregion [list 0 0 $width $height] \
        -xscrollcommand "$mytoplevel.xscroll set" \
        -yscrollcommand "$mytoplevel.yscroll set"
    scrollbar $mytoplevel.xscroll -orient horizontal -command "$mycanvas xview"
    scrollbar $mytoplevel.yscroll -orient vertical -command "$mycanvas yview"
    pack $mycanvas -side left -expand 1 -fill both

    ::pd_bindings::canvas_bindings $mytoplevel

    # give focus to the canvas so it gets the events rather than the window
    focus $mycanvas

    # let the scrollbar logic determine if it should make things scrollable
    set ::xscrollable($mycanvas) 0
    set ::yscrollable($mycanvas) 0

    # this should be at the end so that the window and canvas are all ready
    # before this variable changes.
    set ::editmode($mytoplevel) $editable
}

proc pdtk_canvas_saveas {name initialfile initialdir} {
    if { ! [file isdirectory $initialdir]} {set initialdir $::env(HOME)}
    set filename [tk_getSaveFile -initialfile $initialfile -initialdir $initialdir \
                      -defaultextension .pd -filetypes $::filetypes]
    if {$filename eq ""} return; # they clicked cancel

    set extension [file extension $filename]
    set oldfilename $filename
    set filename [regsub -- "$extension$" $filename [string tolower $extension]]
    if { ! [regexp -- "\.(pd|pat|mxt)$" $filename]} {
        # we need the file extention even on Mac OS X
        set filename $filename.pd
    }
    # test again after downcasing and maybe adding a ".pd" on the end
    if {$filename ne $oldfilename && [file exists $filename]} {
        set answer [tk_messageBox -type okcancel -icon question -default cancel\
                        -message [_ "\"$filename\" already exists. Do you want to replace it?"]]
        if {$answer eq "cancel"} return; # they clicked cancel
    }
    set dirname [file dirname $filename]
    set basename [file tail $filename]
    pdsend "$name savetofile [enquote_path $basename] [enquote_path $dirname]"
    set ::filenewdir $dirname
}

#------------------------------------------------------------------------------#
# mouse usage

proc pdtk_canvas_motion {mycanvas x y mods} {
    set mytoplevel [winfo toplevel $mycanvas]
    pdsend "$mytoplevel motion [$mycanvas canvasx $x] [$mycanvas canvasy $y] $mods"
}

proc pdtk_canvas_mouse {mycanvas x y b f} {
    set mytoplevel [winfo toplevel $mycanvas]
    pdsend "$mytoplevel mouse [$mycanvas canvasx $x] [$mycanvas canvasy $y] $b $f"
}

proc pdtk_canvas_mouseup {mycanvas x y b} {
    set mytoplevel [winfo toplevel $mycanvas]
    pdsend "$mytoplevel mouseup [$mycanvas canvasx $x] [$mycanvas canvasy $y] $b"
}

proc pdtk_canvas_rightclick {mycanvas x y b} {
    set mytoplevel [winfo toplevel $mycanvas]
    pdsend "$mytoplevel mouse [$mycanvas canvasx $x] [$mycanvas canvasy $y] $b 8"
}

# on X11, button 2 pastes from X11 clipboard, so simulate normal paste actions
proc pdtk_canvas_clickpaste {mycanvas x y b} {
    pdtk_canvas_mouse $mycanvas $x $y $b 0
    pdtk_canvas_mouseup $mycanvas $x $y $b
    pdtk_pastetext
}

#------------------------------------------------------------------------------#
# canvas popup menu

# since there is one popup that is used for all canvas windows, the menu
# -commands use {} quotes so that $::focused_window is interpreted when the
# menu item is called, not when the command is mapped to the menu item.  This
# is the same as the menubar in pd_menus.tcl but the opposite of the 'bind'
# commands in pd_bindings.tcl
proc ::pdtk_canvas::create_popup {} {
    if { ! [winfo exists .popup]} {
        # the popup menu for the canvas
        menu .popup -tearoff false
        .popup add command -label [_ "Properties"] \
            -command {::pdtk_canvas::popup_action $::focused_window 0}
        .popup add command -label [_ "Open"]       \
            -command {::pdtk_canvas::popup_action $::focused_window 1}
        .popup add command -label [_ "Help"]       \
            -command {::pdtk_canvas::popup_action $::focused_window 2}
    }
}

proc ::pdtk_canvas::popup_action {mytoplevel action} {
    pdsend "$mytoplevel done-popup $action $::popup_xpix $::popup_ypix"
}

proc ::pdtk_canvas::pdtk_canvas_popup {mytoplevel xpix ypix hasproperties hasopen} {
    set ::popup_xpix $xpix
    set ::popup_ypix $ypix
    if {$hasproperties} {
        .popup entryconfigure [_ "Properties"] -state normal
    } else {
        .popup entryconfigure [_ "Properties"] -state disabled
    }
    if {$hasopen} {
        .popup entryconfigure [_ "Open"] -state normal
    } else {
        .popup entryconfigure [_ "Open"] -state disabled
    }
    set mycanvas "$mytoplevel.c"
    tk_popup .popup [expr $xpix + [winfo rootx $mycanvas]] \
        [expr $ypix + [winfo rooty $mycanvas]] 0
}


#------------------------------------------------------------------------------#
# procs for canvas events

# check or uncheck the "edit" menu item
proc pdtk_canvas_editval {mytoplevel value} {
    set ::editmode($mytoplevel) $value
# TODO figure how to change Edit Mode/Interact Mode text and have menu
# enabling and disabling working still in pd_menus.tcl
#    if {$value == 0} {
#        $::pd_menus::menubar.edit entryconfigure [_ "Interact Mode"] -label [_ "Edit Mode"]
#    } else {
#        $::pd_menus::menubar.edit entryconfigure [_ "Edit Mode"] -label [_ "Interact Mode"]
#    }
    #$mytoplevel.menubar.edit entryconfigure [_ "Edit Mode"] -indicatoron $value
    # TODO make this work, probably with a proc in pd_menus, or maybe the menu
    # item can track the editmode variable
}

# message from Pd to update the currently available undo/redo action
proc pdtk_undomenu {mytoplevel undoaction redoaction} {
    set ::undo_toplevel $mytoplevel
    set ::undo_action $undoaction
    set ::redo_action $redoaction
    if {$mytoplevel ne "nobody"} {
        ::pd_menus::update_undo_on_menu $mytoplevel
    }
}

# this proc gets both mytoplevel and mycanvas sent to it.  When a canvas has
# completed loading, then mycanvas is sent to this proc, so we can use that as
# a test for whether the canvas has completed loading.  Otherwise, we just use
# mytoplevel for the scrolling.
proc pdtk_canvas_getscroll {mycanvas} {
    if {$mycanvas eq ".pdwindow"} {return}
    set mytoplevel [winfo toplevel $mycanvas]    
    # if we received the name of a canvas, then set ::loaded and return
    if {$mytoplevel ne $mycanvas} {
        if {! $::loaded($mytoplevel)} {set ::loaded($mytoplevel) 1}
    }
    set mycanvas $mytoplevel.c
    set bbox [$mycanvas bbox all]
    if {$bbox eq "" || [llength $bbox] != 4} {return}
    set xupperleft [lindex $bbox 0]
    set yupperleft [lindex $bbox 1]
    if {$xupperleft > 0} {set xupperleft 0}
    if {$yupperleft > 0} {set yupperleft 0}
    set scrollregion [concat $xupperleft $yupperleft [lindex $bbox 2] [lindex $bbox 3]]
    $mycanvas configure -scrollregion $scrollregion
    # X scrollbar
    if {[lindex [$mycanvas xview] 0] == 0.0 && [lindex [$mycanvas xview] 1] == 1.0} {
        set ::xscrollable($mycanvas) 0
        pack forget $mytoplevel.xscroll
    } else {
        set ::xscrollable($mycanvas) 1
        pack $mytoplevel.xscroll -side bottom -fill x -before $mycanvas
    }
    # Y scrollbar, it gets touchy at the limit, so say > 0.995
    if {[lindex [$mycanvas yview] 0] == 0.0 && [lindex [$mycanvas yview] 1] > 0.995} {
        set ::yscrollable($mycanvas) 0
        pack forget $mytoplevel.yscroll
    } else {
        set ::yscrollable($mycanvas) 1
        pack $mytoplevel.yscroll -side right -fill y -before $mycanvas
    }
}

proc ::pdtk_canvas::scroll {mycanvas axis amount} {
    if {$axis eq "x" && $::xscrollable($mycanvas) == 1} {
        $mycanvas xview scroll [expr {- ($amount)}] units
    }
    if {$axis eq "y" && $::yscrollable($mycanvas) == 1} {
        $mycanvas yview scroll [expr {- ($amount)}] units
    }
}

